home *** CD-ROM | disk | FTP | other *** search
/ MacWorld 1999 July / Macworld (1999-07).dmg / Shareware World / Info / For Developers / Mops 3.4.sea / Mops source / Toolbox classes / Window+ < prev    next >
Text File  |  1999-02-06  |  5KB  |  234 lines
  1. \ Window+ class - a window that supports views.
  2.  
  3. \ Oct 91    mrh    Initial version.
  4. \ May 92    mrh    "New-style" controls
  5. \ Feb 93    mrh    Added sending idle: to the contView
  6. \ Sept 93    mrh    Revised for Control now being a View subclass.
  7.  
  8. need    view
  9. need    scroller
  10.  
  11. rect    aRect
  12.  
  13. :class    WINDOW+  super{ window }
  14. record
  15. {    ptr        ^contview        \ points to view consisting of contents rect.
  16.     bool    zoomflg
  17. }
  18.  
  19. private
  20.  
  21. :m SetContViewBounds:  { \ l t r b -- }
  22.     getRect: super  -> b -> r -> t -> l
  23.     l t r 1+ b 1+  setBounds: [ get: ^contView ]
  24.     moved: [ get: ^contView ]
  25.     0 0 32000 dup  put: tempRect  update: tempRect
  26. ;m
  27.  
  28. public
  29.  
  30. :m SETZOOM:        \ ( b -- )  Passed-in boolean indicates if this window
  31.                 \        will be  zoomable.
  32.     put: zoomFlg  ;m
  33.  
  34. :m SETVIEW:  { ^view -- }
  35.     ^view  put: ^contView  ^base setWindow: [ ^view ]  ;m
  36.  
  37. :m GETVIEW:    get: ^contView  ;m
  38.  
  39.  
  40. :m NEW:  { bndsRect tAddr tLen procID vis goAway ^view \ s255 -- }
  41.  
  42.     get: alive  ?EXIT                        \ Out if already alive
  43.     ^view  setView: self
  44. \    ?disable_actW
  45.     tAddr tLen  str255  -> s255
  46.     ^base  bndsrect  s255
  47.     vis 1 and
  48.     get: zoomFlg  8 and  procID +
  49.     inFront  goAway 1 and
  50.     0                                \ default is initially in front
  51.     get: color?
  52.     IF  NewCWindow  ELSE  NewWindow  THEN  drop
  53.     initNewWindow: self
  54.     setContViewBounds: self
  55.     ^view  put: ^view_in_focus        \ initial default
  56.     new: [ get: ^contView ]            \ Fire up view object
  57. ;m
  58.  
  59.  
  60. :m GETNEW:  { resID ^view -- }
  61.     get: alive  ?EXIT                \ Out if already alive
  62.     ^view  setView: self
  63.     resID  getnew: super
  64.     setContViewBounds: self
  65.     ^view  put: ^view_in_focus        \ initial default
  66.     new: [ get: ^contView ]            \ Fire up view object
  67. ;m
  68.  
  69.  
  70. :m GROW:
  71.     grow: super  set: super
  72.     setContViewBounds: self  ;m
  73.  
  74. :m ZOOM:
  75.     zoom: super  set: super
  76.     setContViewBounds: self  ;m
  77.  
  78.  
  79. :m ENABLE:
  80.     enable: super        \ Note - we do this first to make sure the
  81.                         \ current grafPort is set before the views
  82.                         \ do anything.
  83.     get: ^contView  enable: []
  84. ;m
  85.  
  86. :m DISABLE:
  87.     get: ^contView  disable: []  disable: super
  88. ;m
  89.  
  90. :m (DRAW):
  91.     (draw): super
  92.     get: ^contview  draw: []
  93. ;m
  94.  
  95. :m DRAW:    (draw): self
  96.             ( noclip )  ;m        \ It seems that when I have scroll bars the
  97.                             \  grow icon gets clipped out unless I call
  98.                             \  noClip here.  (The callLast routine
  99.                             \  windupDraw: is where it's actually drawn).
  100.  
  101. \ IDLE: calls IDLE: on the contView (which will lead to it being called on
  102. \  all views).  We do this regardless of what view is in focus, to give
  103. \  views a chance to do background stuff.
  104. \ We ensure this window is the current Grafport, since the views
  105. \ might want to look at the mouse position in local coordinates.
  106.  
  107. :m IDLE:   { \ xx -- }
  108.     idle: super
  109.     pushPort  set: self
  110.     get: ^contView  idle: []
  111.     popPort  ;m
  112.  
  113.  
  114. :m CLOSE:        \ Releases the views and closes the window
  115.     get: ^contView  release: **
  116.     close: super  ;m
  117.  
  118.  
  119. :m CONTENT:        \ Handles a content click.  We call the contview to find
  120.                 \  which view (if any) wants the click, then send CLICK:
  121.                 \  to it.
  122.     active: self
  123.     IF        noClip
  124.             get: ^contView  view_for_click?: []
  125.             IF  click: []  THEN    
  126.     ELSE    select: self
  127.     THEN  ;m
  128.  
  129.  
  130. :m KEY:        \ ( c -- )  For typed keys, we send a KEY: to the
  131.             \ view in focus, if there is one.
  132.     nil?: ^view_in_focus
  133.     IF        drop
  134.     ELSE    key: [ get: ^view_in_focus ]
  135.     THEN  ;m
  136.     
  137.  
  138. :m TEST:  { ^view -- }
  139.     screenbits true setGrow: self
  140.     true  setZoom: self
  141.     100 100 400 200 put: aRect        \ can't use tempRect - gets clobbered
  142.     aRect  " Test"  docWind  true true  ^view  new: self ;m
  143.  
  144. :m TESTR:  { resID ^view -- }
  145.     screenbits true setGrow: self
  146.     true  setZoom: self
  147.     resID ^view  getnew: self  ;m
  148.  
  149. ;class
  150.  
  151.  
  152. endload
  153.  
  154. \ TESTING:
  155.  
  156.  
  157. window+        WW
  158. scroller    S1                            \ This will be the contview of WW
  159. scroller    S2                            \ A child of S1 - another scroller!
  160.             20 20  150 200   setBounds: s2
  161.  
  162. view        VV                            \ A child of S2
  163.             32 32  628 328  setBounds: vv
  164.  
  165.    screenbits    true  setGrow: ww
  166.                 true  setZoom: ww
  167.  
  168. : DRW  { \ l t r b -- }        \ Draws a big X across the view area.
  169.     ( clear: temprect )  get: tempRect  -> b  -> r  -> t  -> l
  170.     0 0 gotoxy  r b LineTo
  171.     l b gotoxy  r 0 LineTo  ;
  172.  
  173. ' drw  setDraw: vv
  174.  
  175.  
  176. : CLICK1        ." clicked s1!" cr  ;
  177. : CLICK2        ." clicked s2!" cr  ;
  178.  
  179. ' click1   setClick: s1     ' click2   setClick: s2
  180.  
  181. : GO
  182.     vv addView: s2  s2  addView: s1
  183.     s1 test: ww
  184.     -modeless
  185.     $ F5EF  setMask: fEvent                \ mask out key up
  186.     BEGIN
  187.         next: fevent
  188.     AGAIN
  189. ;
  190.  
  191.     
  192. : GORES
  193.     vv addView: s2  s2  addView: s1
  194.     256 s1 testR: ww  ;
  195.  
  196. \ endload
  197.  
  198.  
  199. \ More testing - this sets up a Scroller.
  200.  
  201. scroller    SS
  202. button        BB            \ A child view which is a button
  203.  
  204.  
  205. 40 40 300 200    setBounds: ss
  206.  
  207. 10 10  " Click here"    init: bb
  208.  
  209.  
  210. : Drawit    draw: tempRect  ;        \ A draw handler which just draws the viewRect
  211.  
  212. : DrawSS    draw: ss  ;                \ Draw handler for fWind for test
  213.  
  214. : Clicked
  215.     noclip
  216.     set: tw    ." clicked " .id: [self] cr
  217. \ Now we expand ss a bit to check if the scroll bars move and resize:
  218.     getBounds: ss
  219.     10 +
  220.     swap 20 + swap
  221.     setBounds: ss  moved: ss  ;
  222.  
  223.  
  224. : contentClick            \ New content click handler for fWind
  225.             click: ss  drop  ;
  226.             
  227. ' drawit    setDraw: ss
  228.  
  229. ' clicked    dup setclick: ss  setclick: bb
  230.  
  231. : scrollerTest
  232.     bb addview: ss
  233.     ss test: ww
  234. ;